home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / bin / glib-mkenums < prev    next >
Text File  |  2006-04-25  |  14KB  |  467 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # glib-mkenums.pl 
  4. # Information about the current enumeration
  5. my $flags;            # Is enumeration a bitmask?
  6. my $option_lowercase_name;            # A lower case name to use as part of the *_get_type() function, instead of the one that we guess.
  7.                         # For instance, when an enum uses abnormal capitalization and we can not guess where to put the underscores.
  8. my $seenbitshift;        # Have we seen bitshift operators?
  9. my $enum_prefix;        # Prefix for this enumeration
  10. my $enumname;            # Name for this enumeration
  11. my $enumshort;            # $enumname without prefix
  12. my $enumindex = 0;        # Global enum counter
  13. my $firstenum = 1;        # Is this the first enumeration per file?
  14. my @entries;            # [ $name, $val ] for each entry
  15.  
  16. sub parse_trigraph {
  17.     my $opts = shift;
  18.     my @opts;
  19.  
  20.     for $opt (split /\s*,\s*/, $opts) {
  21.     $opt =~ s/^\s*//;
  22.     $opt =~ s/\s*$//;
  23.         my ($key,$val) = $opt =~ /(\w+)(?:=(.+))?/;
  24.     defined $val or $val = 1;
  25.     push @opts, $key, $val;
  26.     }
  27.     @opts;
  28. }
  29. sub parse_entries {
  30.     my $file = shift;
  31.     my $file_name = shift;
  32.     my $looking_for_name = 0;
  33.     
  34.     while (<$file>) {
  35.     # read lines until we have no open comments
  36.     while (m@/\*([^*]|\*(?!/))*$@) {
  37.         my $new;
  38.         defined ($new = <$file>) || die "Unmatched comment in $ARGV";
  39.         $_ .= $new;
  40.     }
  41.     # strip comments w/o options
  42.     s@/\*(?!<)
  43.         ([^*]+|\*(?!/))*
  44.        \*/@@gx;
  45.     
  46.     # strip newlines
  47.     s@\n@ @;
  48.     
  49.     # skip empty lines
  50.     next if m@^\s*$@;
  51.     
  52.     if ($looking_for_name) {
  53.         if (/^\s*(\w+)/) {
  54.         $enumname = $1;
  55.         return 1;
  56.         }
  57.     }
  58.     
  59.     # Handle include files
  60.     if (/^\#include\s*<([^>]*)>/ ) {
  61.             my $file= "../$1";
  62.         open NEWFILE, $file or die "Cannot open include file $file: $!\n";
  63.         
  64.         if (parse_entries (\*NEWFILE, $NEWFILE)) {
  65.         return 1;
  66.         } else {
  67.         next;
  68.         }
  69.     }
  70.     
  71.     if (/^\s*\}\s*(\w+)/) {
  72.         $enumname = $1;
  73.         $enumindex++;
  74.         return 1;
  75.     }
  76.     
  77.     if (/^\s*\}/) {
  78.         $enumindex++;
  79.         $looking_for_name = 1;
  80.         next;
  81.     }
  82.  
  83.         if (m@^\s*
  84.               (\w+)\s*                   # name
  85.               (?:=(                      # value
  86.            \s*\w+\s*\(.*\)\s*       # macro with multiple args
  87.            |                        # OR
  88.                    (?:[^,/]|/(?!\*))*       # anything but a comma or comment
  89.                   ))?,?\s*
  90.               (?:/\*<                    # options
  91.                 (([^*]|\*(?!/))*)
  92.                >\s*\*/)?,?
  93.               \s*$
  94.              @x) {
  95.             my ($name, $value, $options) = ($1,$2,$3);
  96.  
  97.         if (!defined $flags && defined $value && $value =~ /<</) {
  98.         $seenbitshift = 1;
  99.         }
  100.  
  101.         if (defined $options) {
  102.         my %options = parse_trigraph($options);
  103.         if (!defined $options{skip}) {
  104.             push @entries, [ $name, $options{nick} ];
  105.         }
  106.         } else {
  107.         push @entries, [ $name ];
  108.         }
  109.     } elsif (m@^\s*\#@) {
  110.         # ignore preprocessor directives
  111.     } else {
  112.         print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
  113.     }
  114.     }
  115.  
  116.     return 0;
  117. }
  118.  
  119. sub version {
  120.     print STDERR "glib-mkenums version glib-2.8.6\n";
  121.     print STDERR "glib-mkenums comes with ABSOLUTELY NO WARRANTY.\n";
  122.     print STDERR "You may redistribute copies of glib-mkenums under the terms of\n";
  123.     print STDERR "the GNU General Public License which can be found in the\n";
  124.     print STDERR "GLib source package. Sources, examples and contact\n";
  125.     print STDERR "information are available at http://www.gtk.org\n";
  126.     exit 0;
  127. }
  128. sub usage {
  129.     print STDERR "Usage: glib-mkenums [options] [files...]\n";
  130.     print STDERR "  --fhead <text>             output file header\n";
  131.     print STDERR "  --fprod <text>             per input file production\n";
  132.     print STDERR "  --ftail <text>             output file trailer\n";
  133.     print STDERR "  --eprod <text>             per enum text (produced prior to value itarations)\n";
  134.     print STDERR "  --vhead <text>             value header, produced before iterating over enum values\n";
  135.     print STDERR "  --vprod <text>             value text, produced for each enum value\n";
  136.     print STDERR "  --vtail <text>             value tail, produced after iterating over enum values\n";
  137.     print STDERR "  --comments <text>          comment structure\n";
  138.     print STDERR "  --template file            template file\n";
  139.     print STDERR "  -h, --help                 show this help message\n";
  140.     print STDERR "  -v, --version              print version informations\n";
  141.     print STDERR "Production text substitutions:\n";
  142.     print STDERR "  \@EnumName\@                 PrefixTheXEnum\n";
  143.     print STDERR "  \@enum_name\@                prefix_the_xenum\n";
  144.     print STDERR "  \@ENUMNAME\@                 PREFIX_THE_XENUM\n";
  145.     print STDERR "  \@ENUMSHORT\@                THE_XENUM\n";
  146.     print STDERR "  \@VALUENAME\@                PREFIX_THE_XVALUE\n";
  147.     print STDERR "  \@valuenick\@                the-xvalue\n";
  148.     print STDERR "  \@type\@                     either enum or flags\n";
  149.     print STDERR "  \@Type\@                     either Enum or Flags\n";
  150.     print STDERR "  \@TYPE\@                     either ENUM or FLAGS\n";
  151.     print STDERR "  \@filename\@                 name of current input file\n";
  152.     exit 0;
  153. }
  154.  
  155. # production variables:
  156. my $fhead = "";   # output file header
  157. my $fprod = "";   # per input file production
  158. my $ftail = "";   # output file trailer
  159. my $eprod = "";   # per enum text (produced prior to value itarations)
  160. my $vhead = "";   # value header, produced before iterating over enum values
  161. my $vprod = "";   # value text, produced for each enum value
  162. my $vtail = "";   # value tail, produced after iterating over enum values
  163. # other options
  164. my $comment_tmpl = "/* \@comment\@ */";
  165.  
  166. sub read_template_file {
  167.   my ($file) = @_;
  168.   my %tmpl = ('file-header', $fhead, 
  169.           'file-production', $fprod, 
  170.           'file-tail', $ftail, 
  171.           'enumeration-production', $eprod,
  172.           'value-header', $vhead,
  173.           'value-production', $vprod,
  174.           'value-tail', $vtail,
  175.           'comment', $comment_tmpl);
  176.   my $in = 'junk';
  177.   open (FILE, $file) || die "Can't open $file: $!\n";
  178.   while (<FILE>) {
  179.     if (/^\/\*\*\*\s+(BEGIN|END)\s+([\w-]+)\s+\*\*\*\//) {
  180.       if (($in eq 'junk') && ($1 eq 'BEGIN') && (exists($tmpl{$2}))) {
  181.     $in = $2;
  182.     next;
  183.       }
  184.       elsif (($in eq $2) && ($1 eq 'END') && (exists($tmpl{$2}))) {
  185.     $in = 'junk';
  186.     next;
  187.       }
  188.       else {
  189.       die "Malformed template file $file\n";
  190.       }
  191.     }
  192.     if (!($in eq 'junk')) {
  193.     $tmpl{$in} .= $_;
  194.     }
  195.   }
  196.   close (FILE);
  197.   if (!($in eq 'junk')) {
  198.       die "Malformed template file $file\n";
  199.   }
  200.   $fhead = $tmpl{'file-header'};
  201.   $fprod = $tmpl{'file-production'};
  202.   $ftail = $tmpl{'file-tail'};
  203.   $eprod = $tmpl{'enumeration-production'};
  204.   $vhead = $tmpl{'value-header'};
  205.   $vprod = $tmpl{'value-production'};
  206.   $vtail = $tmpl{'value-tail'};
  207.   $comment_tmpl = $tmpl{'comment'};
  208. }
  209.  
  210. if (!defined $ARGV[0]) {
  211.     usage;
  212. }
  213. while ($_ = $ARGV[0], /^-/) {
  214.     shift;
  215.     last if /^--$/;
  216.     if (/^--template$/)              { read_template_file (shift); }
  217.     elsif (/^--fhead$/)              { $fhead = $fhead . shift }
  218.     elsif (/^--fprod$/)              { $fprod = $fprod . shift }
  219.     elsif (/^--ftail$/)              { $ftail = $ftail . shift }
  220.     elsif (/^--eprod$/)              { $eprod = $eprod . shift }
  221.     elsif (/^--vhead$/)              { $vhead = $vhead . shift }
  222.     elsif (/^--vprod$/)              { $vprod = $vprod . shift }
  223.     elsif (/^--vtail$/)              { $vtail = $vtail . shift }
  224.     elsif (/^--comments$/)           { $comment_tmpl = shift }
  225.     elsif (/^--help$/ || /^-h$/)     { usage; }
  226.     elsif (/^--version$/ || /^-v$/)  { version; }
  227.     else { usage; }
  228. }
  229.  
  230. # put auto-generation comment
  231. {
  232.     my $comment = $comment_tmpl;
  233.     $comment =~ s/\@comment\@/Generated data (by glib-mkenums)/;
  234.     print "\n" . $comment . "\n\n";
  235. }
  236.  
  237. if (length($fhead)) {
  238.     my $prod = $fhead;
  239.  
  240.     $prod =~ s/\@filename\@/$ARGV[0]/g;
  241.     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  242.     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  243.     chomp ($prod);
  244.         
  245.     print "$prod\n";
  246. }
  247.  
  248. while (<>) {
  249.     if (eof) {
  250.     close (ARGV);        # reset line numbering
  251.     $firstenum = 1;        # Flag to print filename at next enum
  252.     }
  253.  
  254.     # read lines until we have no open comments
  255.     while (m@/\*([^*]|\*(?!/))*$@) {
  256.     my $new;
  257.     defined ($new = <>) || die "Unmatched comment in $ARGV";
  258.     $_ .= $new;
  259.     }
  260.     # strip comments w/o options
  261.     s@/\*(?!<)
  262.        ([^*]+|\*(?!/))*
  263.        \*/@@gx;
  264.     
  265.     if (m@^\s*typedef\s+enum\s*
  266.            ({)?\s*
  267.            (?:/\*<
  268.              (([^*]|\*(?!/))*)
  269.             >\s*\*/)?
  270.            \s*({)?
  271.          @x) {
  272.     if (defined $2) {
  273.         my %options = parse_trigraph ($2);
  274.         next if defined $options{skip};
  275.         $enum_prefix = $options{prefix};
  276.         $flags = $options{flags};
  277.       $option_lowercase_name = $options{lowercase_name};
  278.     } else {
  279.         $enum_prefix = undef;
  280.         $flags = undef;
  281.       $option_lowercase_name = undef;
  282.     }
  283.     # Didn't have trailing '{' look on next lines
  284.     if (!defined $1 && !defined $4) {
  285.         while (<>) {
  286.         if (s/^\s*\{//) {
  287.             last;
  288.         }
  289.         }
  290.     }
  291.  
  292.     $seenbitshift = 0;
  293.     @entries = ();
  294.  
  295.     # Now parse the entries
  296.     parse_entries (\*ARGV, $ARGV);
  297.  
  298.     # figure out if this was a flags or enums enumeration
  299.     if (!defined $flags) {
  300.         $flags = $seenbitshift;
  301.     }
  302.  
  303.     # Autogenerate a prefix
  304.     if (!defined $enum_prefix) {
  305.         for (@entries) {
  306.         my $nick = $_->[1];
  307.         if (!defined $nick) {
  308.             my $name = $_->[0];
  309.             if (defined $enum_prefix) {
  310.             my $tmp = ~ ($name ^ $enum_prefix);
  311.             ($tmp) = $tmp =~ /(^\xff*)/;
  312.             $enum_prefix = $enum_prefix & $tmp;
  313.             } else {
  314.             $enum_prefix = $name;
  315.             }
  316.         }
  317.         }
  318.         if (!defined $enum_prefix) {
  319.         $enum_prefix = "";
  320.         } else {
  321.         # Trim so that it ends in an underscore
  322.         $enum_prefix =~ s/_[^_]*$/_/;
  323.         }
  324.     } else {
  325.         # canonicalize user defined prefixes
  326.         $enum_prefix = uc($enum_prefix);
  327.         $enum_prefix =~ s/-/_/g;
  328.         $enum_prefix =~ s/(.*)([^_])$/$1$2_/;
  329.     }
  330.     
  331.     for $entry (@entries) {
  332.         my ($name,$nick) = @{$entry};
  333.             if (!defined $nick) {
  334.              ($nick = $name) =~ s/^$enum_prefix//;
  335.             $nick =~ tr/_/-/;
  336.             $nick = lc($nick);
  337.             @{$entry} = ($name, $nick);
  338.             }
  339.     }
  340.     
  341.  
  342.     # Spit out the output
  343.     
  344.     # enumname is e.g. GMatchType
  345.     $enspace = $enumname;
  346.     $enspace =~ s/^([A-Z][a-z]*).*$/$1/;
  347.     
  348.     $enumshort = $enumname;
  349.     $enumshort =~ s/^[A-Z][a-z]*//;
  350.     $enumshort =~ s/([^A-Z])([A-Z])/$1_$2/g;
  351.     $enumshort =~ s/([A-Z][A-Z])([A-Z][0-9a-z])/$1_$2/g;
  352.     $enumshort = uc($enumshort);
  353.  
  354.     $enumlong = uc($enspace) . "_" . $enumshort;
  355.     $enumsym = lc($enspace) . "_" . lc($enumshort);
  356.  
  357.   #The options might override the lower case name if it could not be generated correctly:
  358.   if (defined($option_lowercase_name)) {
  359.       $enumsym = $option_lowercase_name;
  360.   }
  361.  
  362.     if ($firstenum) {
  363.         $firstenum = 0;
  364.         
  365.         if (length($fprod)) {
  366.         my $prod = $fprod;
  367.  
  368.         $prod =~ s/\@filename\@/$ARGV/g;
  369.         $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  370.         $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  371.             chomp ($prod);
  372.         
  373.         print "$prod\n";
  374.         }
  375.     }
  376.     
  377.     if (length($eprod)) {
  378.         my $prod = $eprod;
  379.  
  380.         $prod =~ s/\@enum_name\@/$enumsym/g;
  381.         $prod =~ s/\@EnumName\@/$enumname/g;
  382.         $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
  383.         $prod =~ s/\@ENUMNAME\@/$enumlong/g;
  384.         if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
  385.         if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
  386.         if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
  387.         $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  388.         $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  389.             chomp ($prod);
  390.  
  391.         print "$prod\n";
  392.     }
  393.  
  394.     if (length($vhead)) {
  395.         my $prod = $vhead;
  396.  
  397.         $prod =~ s/\@enum_name\@/$enumsym/g;
  398.             $prod =~ s/\@EnumName\@/$enumname/g;
  399.             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
  400.             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
  401.         if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
  402.         if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
  403.         if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
  404.             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  405.             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  406.             chomp ($prod);
  407.         
  408.             print "$prod\n";
  409.     }
  410.  
  411.     if (length($vprod)) {
  412.         my $prod = $vprod;
  413.         
  414.         $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  415.         $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  416.         for (@entries) {
  417.         my ($name,$nick) = @{$_};
  418.         my $tmp_prod = $prod;
  419.  
  420.         $tmp_prod =~ s/\@VALUENAME\@/$name/g;
  421.         $tmp_prod =~ s/\@valuenick\@/$nick/g;
  422.         if ($flags) { $tmp_prod =~ s/\@type\@/flags/g; } else { $tmp_prod =~ s/\@type\@/enum/g; }
  423.         if ($flags) { $tmp_prod =~ s/\@Type\@/Flags/g; } else { $tmp_prod =~ s/\@Type\@/Enum/g; }
  424.         if ($flags) { $tmp_prod =~ s/\@TYPE\@/FLAGS/g; } else { $tmp_prod =~ s/\@TYPE\@/ENUM/g; }
  425.         chomp ($tmp_prod);
  426.  
  427.         print "$tmp_prod\n";
  428.         }
  429.     }
  430.  
  431.     if (length($vtail)) {
  432.         my $prod = $vtail;
  433.  
  434.         $prod =~ s/\@enum_name\@/$enumsym/g;
  435.             $prod =~ s/\@EnumName\@/$enumname/g;
  436.             $prod =~ s/\@ENUMSHORT\@/$enumshort/g;
  437.             $prod =~ s/\@ENUMNAME\@/$enumlong/g;
  438.         if ($flags) { $prod =~ s/\@type\@/flags/g; } else { $prod =~ s/\@type\@/enum/g; }
  439.         if ($flags) { $prod =~ s/\@Type\@/Flags/g; } else { $prod =~ s/\@Type\@/Enum/g; }
  440.         if ($flags) { $prod =~ s/\@TYPE\@/FLAGS/g; } else { $prod =~ s/\@TYPE\@/ENUM/g; }
  441.             $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  442.             $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  443.             chomp ($prod);
  444.         
  445.             print "$prod\n";
  446.     }
  447.     }
  448. }
  449.  
  450. if (length($ftail)) {
  451.     my $prod = $ftail;
  452.  
  453.     $prod =~ s/\@filename\@/$ARGV/g;
  454.     $prod =~ s/\\a/\a/g; $prod =~ s/\\b/\b/g; $prod =~ s/\\t/\t/g; $prod =~ s/\\n/\n/g;
  455.     $prod =~ s/\\f/\f/g; $prod =~ s/\\r/\r/g;
  456.     chomp ($prod);
  457.         
  458.     print "$prod\n";
  459. }
  460.  
  461. # put auto-generation comment
  462. {
  463.     my $comment = $comment_tmpl;
  464.     $comment =~ s/\@comment\@/Generated data ends here/;
  465.     print "\n" . $comment . "\n\n";
  466. }
  467.